CD Ware Multimedia 1995 May/cd Ware (Juegos) Epimundo.iso/WIN/VB_DB/PROFIT.ZIP/INGGRMNT.FRM

Visual Basic Form | 1993-03-19 | 11.4 KB | 435 lines

VERSION 2.00
Begin Form IngGrMnt
   BackColor       =   &H00E0FFFF&
   Caption         =   "Ingredient Group File Maintenance"
   Height          =   1875
   Icon            =   INGGRMNT.FRX:0000
   Left            =   1950
   LinkMode        =   1  'Source
   LinkTopic       =   "IngGrMnt"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   1470
   ScaleWidth      =   6225
   Top             =   2805
   Width           =   6345
   Begin CommandButton CmdClose
      Caption         =   "&Close"
      Height          =   375
      Left            =   5280
      TabIndex        =   10
      Top             =   960
      Width           =   855
   End
   Begin CommandButton CmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   4440
      TabIndex        =   9
      Top             =   960
      Width           =   855
   End
   Begin CommandButton CmdDelete
      Caption         =   "&Delete"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   3480
      TabIndex        =   8
      Top             =   960
      Width           =   855
   End
   Begin CommandButton CmdUpdate
      Caption         =   "&Update"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   2640
      TabIndex        =   7
      Top             =   960
      Width           =   855
   End
   Begin CommandButton CmdAdd
      Caption         =   "&Add"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   1800
      TabIndex        =   6
      Top             =   960
      Width           =   855
   End
   Begin CommandButton CmdNext
      BackColor       =   &H00FFFFFF&
      Caption         =   "&Next"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   840
      TabIndex        =   5
      Top             =   960
      Width           =   735
   End
   Begin CommandButton CmdPrevious
      Caption         =   "&Previous"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   960
      Width           =   735
   End
   Begin TextBox Text3
      Height          =   375
      Left            =   2160
      TabIndex        =   3
      Top             =   480
      Width           =   3975
   End
   Begin TextBox Text2
      Height          =   375
      Left            =   2160
      TabIndex        =   1
      Top             =   120
      Width           =   615
   End
   Begin Label LblDesc
      Alignment       =   1  'Right Justify
      BackColor       =   &H00E0FFFF&
      Caption         =   "D&escription:"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   480
      Width           =   1815
   End
   Begin Label LblKey
      Alignment       =   1  'Right Justify
      BackColor       =   &H00E0FFFF&
      Caption         =   "&Group No:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1695
   End
'*************************************************************
'*  Form Name:  IngGrMnt                                     *
'*  Performs file maintenance to Ingredient group file.          *
'*************************************************************
  Dim EntryMode As String * 1
  Dim FieldError As Integer
  Dim DeactivatedKey As String
Sub ClearAllFields ()
  EntryMode = "N"
  Text2.Text = ""
  Text3.Text = ""
  Text2.SetFocus
  SetCmdFlags
End Sub
Sub ClearDataFields ()
  Text3.Text = ""
End Sub
Sub CmdAdd_Click ()
    ErrorCheckFields
    MoveFieldsToRecord
    If Not FieldError Then
    WriteIngGroup
    Select Case IngGroupSt%
      Case 0
        ClearAllFields
      Case 3
        MsgIngGroupNotOpen
      Case 5
        Msg$ = "Ingredient Group already on file."
        T1% = MsgBox(Msg$, 0, "Note")
        Text2.SetFocus
      Case Else
        MsgUnknownIngGroupError
    End Select
    End If
End Sub
Sub CmdCancel_Click ()
  If EntryMode = "C" Then
    Text2.Text = IngGroupSaveRec.IngGroup
    Text3.Text = RTrim$(IngGroupSaveRec.IngGroupDesc)
    Text3.SetFocus
    Text3.SelStart = Len(Text3.Text)
    EntryMode = "U"
    SetCmdFlags
  Else
    ClearAllFields
  End If
End Sub
Sub CmdClose_Click ()
  Unload IngGrMnt
End Sub
Sub CmdDelete_Click ()
    Msg$ = "Are you sure?"
    TI% = MsgBox(Msg$, 260, "Delete?")
    If TI% = 6 Then
      DeleteIngGroup
      Select Case IngGroupSt%
    Case 0
      ClearAllFields
    Case 8
      Msg$ = "Record must be found before you can delete."
      Beep
      T1% = MsgBox(Msg$, 0, "Warning!")
    Case 80
      Msg$ = "This record updated since read. Reread and try again."
      Beep
      T1% = MsgBox(Msg$, 0, "Not Deleted!")
    Case Else
      Msg$ = "Ingredient Group not deleted.  Status = " + Str$(IngGroupSt%)
      Beep
      T1% = MsgBox(Msg$, 0, "Warning!")
      End Select
    End If
End Sub
Sub CmdNext_Click ()
  NextIngGroup
  Select Case IngGroupSt%
    Case 0
      DisplayDataFields
    Case 3
      MsgIngGroupNotOpen
    Case 8
      FirstIngGroup
      If IngGroupSt% <> 0 Then
    MsgUnknownIngGroupError
      Else
    DisplayDataFields
      End If
    Case 9
      Msg$ = "End of Ingredient Group file."
      T1% = MsgBox(Msg$, 0, "Note")
    Case Else
      MsgUnknownIngGroupError
  End Select
End Sub
Sub CmdPrevious_Click ()
  PreviousIngGroup
  Select Case IngGroupSt%
    Case 0
      DisplayDataFields
    Case 3
      MsgIngGroupNotOpen
    Case 8
      FirstIngGroup
      If IngGroupSt% <> 0 Then
    MsgUnknownIngGroupError
      Else
    DisplayDataFields
      End If
    Case 9
      Msg$ = "Beginning of Ingredient Group file."
      T1% = MsgBox(Msg$, 0, "Note")
    Case Else
      MsgUnknownIngGroupError
  End Select
End Sub
Sub CmdUpdate_Click ()
    EntryMode = "C"
    IngGroupRec.IngGroupDesc = Text3.Text
    UpdateIngGroup
    Select Case IngGroupSt%
      Case 0
    EntryMode = "N"
    ClearAllFields
      Case 3
    MsgIngGroupNotOpen
      Case 5
    Msg$ = "Ingredient Group duplicate on file."
    T1% = MsgBox(Msg$, 0, "Note")
      Case 8
    Msg$ = "Update only works on found records."
    T1% = MsgBox(Msg$, 0, "Note")
      Case 80
    Msg$ = "This record updated since read. Reread and try again."
    T1% = MsgBox(Msg$, 0, "Warning!")
      Case Else
    MsgUnknownIngGroupError
    End Select
End Sub
Sub DisplayDataFields ()
    IngGroupSaveRec = IngGroupRec
    Text2.Text = IngGroupRec.IngGroup
    Text3.Text = RTrim$(IngGroupRec.IngGroupDesc)
    Text3.SetFocus
    EntryMode = "U"
    SetCmdFlags
End Sub
Sub ErrorCheckFields ()
  FieldError = False
  If LTrim$(RTrim$(Text2.Text)) = "" Then
    Msg$ = "Ingredient Group number is required."
    T1% = MsgBox(Msg$, 0, "Note")
    FieldError = True
    Text2.SetFocus
    Exit Sub
  End If
  If LTrim$(RTrim$(Text3.Text)) = "" Then
    Msg$ = "You must have a description."
    T1% = MsgBox(Msg$, 0, "Note")
    FieldError = True
    Text3.SetFocus
    Exit Sub
  End If
End Sub
Sub Form_Activate ()
   If DeactivatedKey <> "" Then
     IngGroupRec.IngGroup = DeactivatedKey
     ReadIngGroup
   End If
End Sub
Sub Form_Deactivate ()
    DeactivatedKey = IngGroupRec.IngGroup
End Sub
Sub Form_Load ()
    DeactivatedKey = ""
    Top = DeliMain.Top + 1320
    Left = DeliMain.Left + 1320
    Height = 1875
    Width = 6345
    EntryMode = "N"
    SetCmdFlags
End Sub
Sub MoveFieldsToRecord ()
    IngGroupRec.IngGroup = String$(4 - Len(Text2.Text), "0") + Text2.Text
    IngGroupRec.IngGroupDesc = Text3.Text
End Sub
Sub SetCmdFlags ()
  Select Case EntryMode
    Case "N"
      CmdPrevious.Enabled = True
      CmdNext.Enabled = True
      CmdCancel.Enabled = False
      CmdAdd.Enabled = True
      CmdUpdate.Enabled = False
      CmdDelete.Enabled = False
    Case "U"
      CmdPrevious.Enabled = True
      CmdNext.Enabled = True
      CmdCancel.Enabled = False
      CmdAdd.Enabled = False
      CmdUpdate.Enabled = True
      CmdDelete.Enabled = True
    Case "C"
      CmdPrevious.Enabled = True
      CmdNext.Enabled = True
      CmdCancel.Enabled = True
      CmdAdd.Enabled = False
      CmdUpdate.Enabled = True
      CmdDelete.Enabled = False
    Case Else
      Msg$ = "Undefined Entry Mode Flag - " + EntryMode + "."
      T1% = MsgBox(Msg$, 0, "Warning!")
  End Select
End Sub
Sub Text2_Change ()
  If EntryMode = "U" Then
    EntryMode = "C"
    SetCmdFlags
  End If
End Sub
Sub Text2_GotFocus ()
  Text2.SelStart = 0
  Text2.SelLength = Len(Text2.Text)
End Sub
Sub Text2_KeyDown (KeyCode As Integer, Shift As Integer)
    If KeyCode = KEY_PAGE_UP Then
    CmdPrevious_Click
    End If
    If KeyCode = KEY_PAGE_DOWN Then
    CmdNext_Click
    End If
End Sub
Sub Text2_KeyPress (KeyAscii As Integer)
  If KeyAscii = 13 Then
    KeyAscii = 0
    Text3.SetFocus
  ElseIf Chr$(KeyAscii) = "-" Then
    KeyAscii = 0
    Beep
  Else
    IntKP Text2, 4, KeyAscii
  End If
End Sub
Sub Text2_LostFocus ()
  If Text2.Text <> "" Then
    EntryMode = "N"
    IngGroupRec.IngGroup = String$(4 - Len(Text2.Text), "0") + Text2.Text
    ReadIngGroup
    Select Case IngGroupSt%
      Case 0
    DisplayDataFields
      Case 3
    MsgIngGroupNotOpen
      Case 4
    ClearDataFields
      Case Else
    MsgUnknownIngGroupError
    End Select
    SetCmdFlags
  End If
End Sub
Sub Text3_Change ()
  If EntryMode = "U" Then
    EntryMode = "C"
    SetCmdFlags
  End If
End Sub
Sub Text3_GotFocus ()
  Text3.SelStart = 0
  Text3.SelLength = Len(Text3.Text)
End Sub
Sub Text3_KeyDown (KeyCode As Integer, Shift As Integer)
    If KeyCode = KEY_PAGE_UP Then
    CmdPrevious_Click
    End If
    If KeyCode = KEY_PAGE_DOWN Then
    CmdNext_Click
    End If
End Sub
Sub Text3_KeyPress (KeyAscii As Integer)
  If KeyAscii = 13 Then
    KeyAscii = 0
    If CmdUpdate.Enabled = True Then
      CmdUpdate.SetFocus
    Else
      CmdAdd.SetFocus
    End If
  Else
    UCStrKP Text3, 30, KeyAscii
  End If
End Sub